perm filename GAME.LSP[206,LSP] blob
sn#544564 filedate 1980-10-25 generic text, type C, neo UTF8
COMMENT ā VALID 00006 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 (DEFPROP GAME
C00003 00003 Value functions
C00005 00004 Line functions
C00007 00005 Tree functions
C00010 00006 Game aux fns
C00011 ENDMK
Cā;
(DEFPROP GAME
(
VLMAX
VMAXLIS
VLMIN
VMINLIS
LMAX
LMAXLIS
LMIN
LMINLIS
TMAX
TMAXLIS
TMIN
TMINLIS
RECTIFY
COMMONTAIL
COMMONHEAD
) FNS)
;;;Value functions
(DEFUN VLMAX (P ALPHA BETA)
(COND ((TER (RECTIFY P) ALPHA BETA) (IMVAL P))
(T (VMAXLIS (SUCCESSORS P) ALPHA BETA)) ))
(DEFUN VMAXLIS (U ALPHA BETA)
(COND ((NULL U) ALPHA)
(T
((LAMBDA(S)
(COND ((NOT (GREATERP S ALPHA))
(VMAXLIS (CDR U) ALPHA BETA))
((LESSP S BETA) (VMAXLIS (CDR U) S BETA))
(T BETA)))
(VLMIN (CAR U) ALPHA BETA))) ))
(DEFUN VLMIN (P ALPHA BETA)
(COND ((TER (RECTIFY P) ALPHA BETA) (IMVAL P))
(T (VMINLIS (SUCCESSORS P) ALPHA BETA)) ))
(DEFUN VMINLIS (U ALPHA BETA)
(COND ((NULL U) BETA)
(T
((LAMBDA(S)
(COND ((NOT (GREATERP S ALPHA)) ALPHA)
((LESSP S BETA) (VMINLIS (CDR U) ALPHA S))
(T (VMINLIS (CDR U) ALPHA BETA))))
(VLMAX (CAR U) ALPHA BETA))) ))
;;;Line functions
(DEFUN LMAX (P ALPHA BETA)
(COND ((TER (RECTIFY P) ALPHA BETA) (LIST (IMVAL P)))
(T (LMAXLIS (SUCCESSORS P)(CONS ALPHA (QUOTE ALPHA-CUTOFF)) ALPHA BETA)) ))
(DEFUN LMAXLIS(U LINE ALPHA BETA)
(COND ((NULL U) (CONS ALPHA LINE))
(T
((LAMBDA(S)
(COND ((NOT (GREATERP (CAR S) ALPHA))
(LMAXLIS (CDR U) LINE ALPHA BETA))
((LESSP (CAR S) BETA)
(LMAXLIS (CDR U)
(CONS (EXT (CAR U)) (CDR S))
(CAR S)
BETA))
(T (CONS BETA LINE))))
(LMIN (CAR U) ALPHA BETA))) ))
(DEFUN LMIN (P ALPHA BETA)
(COND ((TER (RECTIFY P) ALPHA BETA) (LIST (IMVAL P)))
(T (LMINLIS (SUCCESSORS P)(CONS BETA (QUOTE BETA-CUTOFF)) ALPHA BETA)) ))
(DEFUN LMINLIS (U LINE ALPHA BETA)
(COND ((NULL U) (CONS BETA LINE))
(T
((LAMBDA(S)
(COND ((NOT (GREATERP (CAR S) ALPHA)) (CONS ALPHA LINE))
((LESSP (CAR S) BETA)
(LMINLIS (CDR U)
(CONS (EXT (CAR U)) (CDR S))
ALPHA
(CAR S)))
(T (LMINLIS (CDR U) LINE ALPHA BETA))))
(LMAX (CAR U) ALPHA BETA))) ))
;;;Tree functions
(DEFUN TMAX (P ALPHA BETA)
(COND ((TER (RECTIFY P) ALPHA BETA)
((LAMBDA (V) (LIST V (LIST V) (LIST V))) (IMVAL P)))
(T (TMAXLIS (SUCCESSORS P)
(CONS ALPHA (QUOTE ALPHA-CUTOFF))
NIL
ALPHA
BETA)) ))
(DEFUN TMAXLIS (U TRMAX TRMIN ALPHA BETA)
(COND
((NULL U) (LIST ALPHA TRMAX TRMIN))
(T
((LAMBDA(S)
(COND
((NOT (GREATERP (CAR S) ALPHA))
(TMAXLIS (CDR U)
TRMAX
(CONS (CONS (EXT (CAR U)) (CADDR S)) TRMIN)
ALPHA
BETA))
((LESSP (CAR S) BETA)
(TMAXLIS (CDR U)
(CONS (EXT (CAR U)) (CADR S))
(CONS (CONS (EXT (CAR U)) (CADDR S)) TRMIN)
(CAR S)
BETA))
(T (LIST BETA (CONS (EXT (CAR U)) (CADR S)) NIL))))
(TMIN (CAR U) ALPHA BETA))) ))
(DEFUN TMIN (P ALPHA BETA)
(COND ((TER (RECTIFY P) ALPHA BETA)
((LAMBDA (V) (LIST V (LIST V) (LIST V))) (IMVAL P)))
(T (TMINLIS (SUCCESSORS P)
NIL
(CONS BETA (QUOTE BETA-CUTOFF))
ALPHA
BETA)) ))
(DEFUN TMINLIS (U TRMAX TRMIN ALPHA BETA)
(COND ((NULL U) (LIST BETA TRMAX TRMIN))
(T ((LAMBDA(S)
(COND ((NOT (GREATERP (CAR S) ALPHA))
(LIST ALPHA NIL (CONS (EXT (CAR U)) (CADDR S))))
((LESSP (CAR S) BETA)
(TMINLIS (CDR U)
(CONS (CONS (EXT (CAR U)) (CADR S)) TRMAX)
(CONS (EXT (CAR U)) (CADDR S))
ALPHA
(CAR S)))
(T (TMINLIS (CDR U)
(CONS (CONS (EXT (CAR U)) (CADR S)) TRMAX)
TRMIN
ALPHA
BETA))))
(TMAX (CAR U) ALPHA BETA))) ))
;;; Game aux fns
(DEFPROP RECTIFY
(LAMBDA(P)
(PROG (Z Q)
(SETQ Q (COMMONTAIL P P1))
L1 (COND ((EQUAL Q P1) (GO L2)))
(REVERT)
(GO L1)
L2 (SETQ Z (LISTSUBT P P1))
L3 (COND ((NULL Z) (RETURN P)))
(UPDATE (CAR Z))
(SETQ Z (CDR Z))
(GO L3)))
EXPR)
(DEFPROP COMMONTAIL
(LAMBDA (U V) (REVERSE (COMMONHEAD (REVERSE U) (REVERSE V))))
EXPR)
(DEFPROP COMMONHEAD
(LAMBDA(U V)
(COND ((OR (NULL U) (NULL V) (NOT (EQUAL (CAR U) (CAR V)))) NIL)
(T (CONS (CAR U) (COMMONHEAD (CDR U) (CDR V))))))
EXPR)